Internet Info 1994 March/Internet Info CD-ROM (Walnut Creek) (March 1994).iso/networking/terms/kermit/c/pq2sen.pas

Pascal/Delphi Source File | 1988-08-16 | 19.9 KB | 719 lines

module KermitSend;

{ the module contains routines for sending files to a remote kermit }

{=========================} exports {========================================}

imports KermitGlobals from KermitGlobals;

function    SendSwitch :   KermitStates;

{=========================} private {========================================}

const
        ACKExp = '?Illegal packet type received - expected ACK packet';
        RecvrAborted = 'Transfer aborted by error packet from receiver';

imports KermitFile from KermitFile;
imports KermitParameters from KermitParameters;
imports KermitLineIO from KermitLineIO;
imports System from System;
imports UtilProgress from UtilProgress;

{-----------------------------------------------------------------------------}

var     FNPacket, FDPacket      : Packet;
        FileName                : FNameType;

{-----------------------------------------------------------------------------}

function SendInitiate : KermitStates;

var     RetVal   : KermitStates;
        Pack     : Packet;
        num      : integer;
        len      : integer;
        status   : integer;
        message  : string;

        handler CtlC;
        begin
            CtrlCPending := false;
            SendInitiate := AbortCtlC;
            exit( SendInitiate );
        end;

begin
    if Debug then begin
        DbgWrite('Enter SendInit');
        DbgNL;
    end;

    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryInit then begin
        LocalError( '?Unable to send initiate' );
        RetVal := AbortAll
    end
    else
    begin

        if Debug then begin
            DbgWrite(' n =');
            DbgInt( n );
            DbgNL;
        end;

        SetInitPars ( Pack );
        SendPacket (    SInitPack,
                        n,
                        -1,
                        Pack );

        case ReadPacket( num, len, Pack ) of

            NAKPack :
                begin
                    RetVal := CurrState;
                end;

            ACKPack :
                begin
                    if num <> n then            (* Wrong ACK ? *)
                        RetVal := CurrState     (* Stay in current state *)
                    else
                    begin
                        ReadPars( Pack );
                        Succeeded;
                        case NextReadFile(FileName) of

                        FNoFile, FNoReadPriv, FReadErr, FCantOpen:
                            begin
                                Message := concat('?Cannot open: ',FileName );
                                SendErrPack( Message );
                                Writeln( Message );
                                RetVal := AbortAll;
                            end;

                        FEndDir:
                            begin
                                Message := Concat('?No files matching: ',
                                                        FileName );
                                Writeln( Message );
                                RetVal := Break;
                            end;

                        FNoError:
                            begin
                                RetVal := FileHeader;
                                PutFileName( FileName, FNPacket );
                            end;

                        end;
                    end;
                end;

            ErrPack:
                begin
                    RetVal := AbortAll;
                    TreatErrPack( Pack, Num );
                    writeln( RecvrAborted );
                end;

            DataPack, SInitPack, BrkPack,
            FHeadPack, EOFPack,
            IllPack :
                begin
                    RetVal := AbortAll;
                    LocalError( ACKExp );
                end;

            ChkIllPack :
                begin
                    if Debug then begin
                        DbgWrite('Illegal checksum read - retrying');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end;

            TimOutPack  :
                begin
                    if Debug then begin
                        DbgWrite('Timed out waiting for ACK for SendInit');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end;

        end;
    end;
    SendInitiate := RetVal;
end;

{-----------------------------------------------------------------------------}

function    SendFileHeader : KermitStates;

var     RetVal  : KermitStates;
        len, i  : integer;
        num     : integer;
        Treated : boolean;
        Pack    : Packet;
        Answer  : PacketType;
        SaveTime: integer;

        handler CtlC;
        begin
            CtrlCPending := false;
            SendFileHeader := AbortCtlC;
            exit( SendFileHeader );
        end;

begin
    if Debug then begin
        DbgWrite('Enter SendFileHeader');
        DbgNL;
    end;

    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        LocalError( '?Unable to receive an ACK for file header' );
        RetVal := AbortAll;     { No use trying a new file header }
    end
    else
    begin

        SendPacket( FHeadPack,
                    n,
                    -1,
                    FNPacket    );

        SaveTime := SendTimeOut;
        SendTimeOut := SendTimeOut * LongWait;
        Answer := ReadPacket( num, len, Pack );
        SendTimeOut := SaveTime;
        Treated := false;

        if Answer = NAKPack then
        begin
            Treated := True;
            Num := Prev( Num );
            if n <> Num then         (* is it a NAK for the next packet? *)
                RetVal := CurrState  (* NO - stay in current state       *)
            else
                Answer := ACKPack;   (* YES - treat as ACK for current   *)
        end;

        if Answer = ACKPack then
        begin
            Treated := true;
            if n <> num then
                RetVal := CurrState
            else
            begin
                Succeeded;
                if FillBuffer( FDPacket ) >= FNoError then
                    RetVal := FileData
                else
                    RetVal := Abort1;
            end;
        end;

        if not Treated then
        begin
            if Answer = TimOutPack then
            begin
                if Debug then begin
                    DbgWrite('Timed out waiting for ACK for File-header');
                    DbgNL;
                end;
                RetVal := CurrState;
            end else
                if Answer = ChkIllPack then begin
                    if Debug then begin
                        DbgWrite('Illegal checksum read - retrying');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else

                    if Answer = ErrPack then begin
                        RetVal := AbortAll;
                        TreatErrPack( Pack, Num );
                        writeln( RecvrAborted );
                    end else
                    begin
                        writeln( ACKExp );
                        SendErrPack( ACKExp );
                        RetVal := AbortAll;
                    end;
        end;
    end;
    SendFileHeader := RetVal;
end;

{-----------------------------------------------------------------------------}

function   SendData : KermitStates;
var     RetVal : KermitStates;
        RecPack: Packet;
        Answer : PacketType;
        len    : integer;
        num    : integer;
        Treated: boolean;

        handler CtlC;
        begin
            CtrlCPending := false;
            SendData := AbortCtlC;
            exit( SendData );
        end;

begin
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        if LocalKermit then
            LocalError( '?Unable to receive an ACK for data packet' );
        RetVal := Abort1;
    end
    else
    begin

        SendPacket( DataPack,
                    n,
                    -1,
                    FDPacket   );

        Answer := ReadPacket( Num, Len, RecPack );
        Treated := false;

        if Answer = NAKPack then
        begin
            Treated := true;
            Num := Prev( Num );
            if n <> Num then
                RetVal := CurrState
            else
                Answer := ACKPack;
        end;

        if Answer = ACKPack then
        begin
            Treated := true;
            if n <> Num then
                RetVal := CurrState
            else
            begin
                Succeeded;
                if EndFile then
                    RetVal := EOFile
                else
                begin
                    if FillBuffer( FDPacket ) >= FNoError then
                        RetVal := CurrState
                    else
                        RetVal := Abort1;
                end;
            end;
        end;

        if not Treated then
        begin
            if Answer = TimOutPack then begin
                if Debug then begin
                    DbgWrite('Timed out waiting for ACK for FileData');
                    DbgNL;
                end;
                RetVal := CurrState;
            end else
                if Answer = ChkIllPack then begin
                    if Debug then begin
                        DbgWrite('Illegal checksum read - retrying');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ErrPack then begin
                        RetVal := AbortAll;
                        TreatErrPack( RecPack, Num );
                        writeln( RecvrAborted );
                    end else
                    begin
                        SendErrPack( ACKExp );
                        writeln( ACKExp );
                        RetVal := Abort1;
                    end;
        end;
    end;
    SendData := RetVal;
end; (* SendData *)

{-----------------------------------------------------------------------------}

function    SendEof : KermitStates;
var     Pack   : Packet;
        Len    : integer;
        Num    : integer;
        RetVal : KermitStates;
        Treated: boolean;
        Answer : PacketType;
        FE     : FileErrs;

        handler CtlC;
        begin
            CtrlCPending := false;
            SendEOF := AbortCtlC;
            exit( SendEOF );
        end;

begin
    if Debug then begin
        DbgWrite('Enter SendEof');
        DbgNL;
    end;
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        if LocalKermit then
            LocalError( '?Unable to receive an ACK for EOF packet' );
        RetVal := Abort1;
    end
    else
    begin

        SendPacket (    EOFPack,
                        n,
                        0,
                        Pack (* Dummy *)   );

        Answer := ReadPacket( Num , Len, Pack );
        Treated := false;
        if Answer = NAKPack then
        begin
            Treated := true;
            Num := Prev( Num );
            if Num <> n then
                RetVal := CurrState
            else
                Answer := ACKPack;
        end;

        if Answer = ACKPack then
        begin
            Treated := true;
            if n <> Num then
                RetVal := CurrState
            else
            begin
                Succeeded;
                FileName := '';
                FE := NextReadFile( FileName );
                repeat
                    if FE=FNoError then begin
                        RetVal := FileHeader;
                        PutFileName( FileName, FNPacket );
                    end else if FE=FEndDir then begin
                        RetVal := Break;
                        FE := FNoError;
                    end else if FE IN [FCantOpen,FNoReadPriv] then begin
                        SendErrPack(
                            '?File open error, terminating file group');
                        writeln(
                            '?File open error, terminating file group');
                        FE := FNoError;
                    end else { Error closing prev. file, retry NextReadFile }
                        FE := NextReadFile( FileName );

                until FE=FNoError;
            end;
        end;

        if not Treated then
        begin
            if Answer = TimOutPack then begin
                if Debug then begin
                    DbgWrite('Timed out waiting for ACK for EOF-packet');
                    DbgNL;
                end;
                RetVal := CurrState;
            end else
                if Answer = ChkIllPack then begin
                    if Debug then begin
                        DbgWrite('Illegal checksum read - retrying');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ErrPack then begin
                        RetVal := AbortAll;
                        TreatErrPack( Pack, Num );
                        writeln( RecvrAborted );
                    end else
                    begin
                        writeln( ACKExp );
                        RetVal := Abort1;
                    end;
        end;
    end;
    SendEOF := RetVal;
end;

{-----------------------------------------------------------------------------}

function    SendBrkP : KermitStates;
var     Answer : PacketType;
        Treated: boolean;
        Pack   : Packet;
        Len    : integer;
        Num    : integer;
        RetVal : KermitStates;

        handler CtlC;
        begin
            CtrlCPending := false;
            SendBrkP := AbortCtlC;
            exit( SendBrkP );
        end;

begin
    FileName := '';
    if Debug then begin
        DbgWrite('Enter Send-break');
        DbgNL;
    end;
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        LocalError( '?Unable to receive an ACK for break packet' );
        RetVal := AbortAll;
    end
    else
    begin
        SendPacket (    BrkPack,
                        n,
                        0,
                        Pack (* dummy *)   );
        Answer := ReadPacket ( Num, Len, Pack );
        Treated := false;
        if Answer = NAKPack then
        begin
            Treated := true;
            Num := Prev( Num );
            if Num <> n then
                RetVal := CurrState
            else
                Answer := ACKPack;
        end;
        if Answer = ACKPack then
        begin
            Treated := true;
            if n <> ord(Num) then
                RetVal := CurrState
            else
            begin
                Succeeded;
                RetVal := Complete;
            end;
        end;
        if not Treated then
        begin
            if Answer = TimOutPack then begin
                if Debug then begin
                    DbgWrite('Timed out waiting for ACK for Brk-packet');
                    DbgNL;
                end;
                RetVal := CurrState;
            end else
                if Answer = ChkIllPack then begin
                    if Debug then begin
                        DbgWrite('Illegal checksum read - retrying');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ErrPack then begin
                        RetVal := AbortAll;
                        TreatErrPack( Pack, Num );
                        writeln( RecvrAborted );
                    end else
                    begin
                        writeln( ACKExp );
                        SendErrPack( ACKExp );
                        RetVal := AbortAll;
                    end;
        end;
    end;
    SendBrkP := RetVal;
end;

{-----------------------------------------------------------------------------}

function    SendDiscard : KermitStates;
var     Answer : PacketType;
        Treated: boolean;
        Pack   : Packet;
        Len    : integer;
        Num    : integer;
        RetVal : KermitStates;

        handler CtlC;
        begin
            CtrlCPending := false;
            SendDiscard := AbortCtlC;
            exit( SendDiscard );
        end;

begin
    if Debug then begin
        DbgWrite('Enter SendDiscard');
        DbgNL;
    end;
    NumTry := NumTry + 1;
    if NumTry>1 then
        TotTry := TotTry + 1;
    if NumTry > MaxTryPack then begin
        LocalError( '?Unable to receive an ACK for EOF discard packet' );
        RetVal := AbortAll;
    end
    else
    begin
        Pack.Data := 'D ';      { EOF discard }
        SendPacket (    EOFPack,
                        n,
                        0,
                        Pack (* dummy *)   );
        Answer := ReadPacket ( Num, Len, Pack );
        Treated := false;
        if Answer = NAKPack then
        begin
            Treated := true;
            Num := Prev( Num );
            if Num <> n then
                RetVal := CurrState
            else
                Answer := ACKPack;
        end;
        if Answer = ACKPack then
        begin
            Treated := true;
            if n <> ord(Num) then
                RetVal := CurrState
            else
            begin
                Succeeded;
                RetVal := Complete;
            end;
        end;
        if not Treated then
        begin
            if Answer = TimOutPack then begin
                if Debug then begin
                    DbgWrite(
                        'Timed out waiting for ACK for EOF-discard packet');
                    DbgNL;
                end;
                RetVal := CurrState;
            end else
                if Answer = ChkIllPack then begin
                    if Debug then begin
                        DbgWrite('Illegal checksum read - retrying');
                        DbgNL;
                    end;
                    RetVal := CurrState;
                end else
                    if Answer = ErrPack then begin
                        RetVal := AbortAll;
                        TreatErrPack( Pack, Num );
                        writeln( RecvrAborted );
                    end else
                    begin
                        writeln( ACKExp );
                        SendErrPack( ACKExp );
                        RetVal := AbortAll;
                    end;
        end;
    end;
    SendDiscard := RetVal;
end;

{-----------------------------------------------------------------------------}

function    SendSwitch :  KermitStates;

var Dummy : FileErrs;

    handler CtlCAbort;
    begin
        CtrlCPending := false;
    end;

begin

    FileName := '';
    CurrState := Init;
    n := 0;
    nn := 0;
    NumTry := 0;
    TotTry := 0;
    InitProgress;
    LoadBusy;
    ShowPackNum;

    while (CurrState <> Complete) and (CurrState <> AbortAll) and
          (CurrState <> AbortCtlC) do
    begin

        case CurrState of
            FileData:
                CurrState := SendData;

            FileHeader:
                CurrState := SendFileHeader;

            Abort1:
                CurrState := SendDiscard;

            EOFile:
                CurrState := SendEof;

            Init:
                CurrState := SendInitiate;

            Break:
                CurrState := SendBrkP;

        end; (* case *)

        ShowPackNum;            { Show last packet number }
        ShowProgress( ProgressLines );
        if Debug then begin
            DbgWrite ( 'SendSwitch :  State transition to --> ' );
            DbgState ( CurrState );
            DbgNL;
        end;

    end; (* while *)

    if CurrState = AbortAll then
        Writeln( 'Transfer was aborted at ', FileName )
    else
        if CurrState = AbortCtlC then begin
            writeln( AbortedByCtlC );
            SendErrPack( AbortedByCtlC );
        end;

    SendSwitch := CurrState;
    Dummy := FileIdle;
    QuitProgress;
end.